Apple II Magazines (PO)

home *** CD-ROM | disk | FTP | other *** search

/ Apple II Magazines (PO) / Nibble Volume 13, No. 04 (1992-04)(MindCraft Publishing)(Side A).zip / Nibble Volume 13, No. 04 (1992-04)(MindCraft Publishing)(Side A).po / SQUEEZER.S < prev next >

Wrap

Text File | 1996-12-24 | 36KB | 1,200 lines

********************************* ** ** ** APPLESOFT SQUEEZER ** ** by Raymond Groenestein ** ** Copyright (C) 1992 ** ** MindCraft Publ. Corp. ** ** Lincoln, MA 01773 ** ** ** ** DOS Toolkit/EDASM ** ********************************* * * LPTR EQU $0 PPTR EQU $2 LOC EQU $3 NPRG EQU $4 FLAG EQU $7 COUNT EQU $8 DEST EQU $8 YSTORE EQU $9 LSTORE EQU $18 CSTORE EQU $18 HSTORE EQU $19 TLN EQU $1A INC EQU $1C LINNUM EQU $50 REMFLG EQU $F8 LEN EQU $F9 COMFLG EQU $FA IFFLG EQU $FB QFLG EQU $FC PRTFLG EQU $FC DATAFLG EQU $FD SVSTACK EQU $FE * * ORG $6000 * * SETUP LDA $AA59 ;FOR BRUN BUG PHA ;STORE LDA $74 ;HIMEM CMP #<2*FINISH-START BCS SU1 ;ENOUGH MEMORY? JSR $FD8E ;CROUT LDA #$F1 ;OUT OF MEMORY JSR DE1 ;PRINT MSG PLA ;FIX STA $AA59 ;STACK RTS ;AND LEAVE SU1 SBC #<FINISH-START+$100 STA DEST ;SAVE * *CHECK FOR PRODOS * LDA $BF00 ;CHECK CMP #$4C ;PRODOS? BEQ PRODOS ;YES, GET A BUFFER * *SET UP HIMEM FOR DOS 3.3 * LDA #0 ;ITS DOS STA $73 ;SET LDA DEST ;UP STA $74 ;HIMEM BNE MODIFY ;ALWAYS * *GET BUFFER FROM PRODOS * PRODOS LDA #<FINISH-START+$100 JSR $BEF5 ;GETBUFR BCC GOTBUF ;IT WORKED? JMP $BE09 ;ERROUT GOTBUF STA DEST ;ADDRESS IN A-REG * *MODIFY THE CODE * MODIFY LDA #START ;SET STA $6 ;UP LDA #<START ;POINTERS STA $7 ;AND MODLP LDY #0 ;GET LDA ($6),Y ;BYTE JSR $F88E ;INSDS2 LDY $2F ;LENGTH CPY #2 ;3 BYTES? BNE NOMOD ;NO, LEAVE IT SEC ;FOR SBC LDA ($6),Y ;HIGH BYTE SBC #<START ;TOO BCC NOMOD ;SMALL? CMP #<FINISH-START+$100 BCS NOMOD ;TOO BIG? ADC DEST ;BYTE STA ($6),Y ;STORE NOMOD TYA ;AND SEC ;MOVE ADC $6 ;POINTERS STA $6 ;TO BCC NOINC ;NEXT INC $7 ;INSTRUCTION NOINC CMP #HEADING ;IS LDA $7 ;ALL SBC #<HEADING ;CODE BCC MODLP ;DONE? * *SAVE OLD & ADDRESS * LDA $3F6 ;STORE STA OLDAMP+1 ;AFTER LDA $3F7 ;MODIFYING STA OLDAMP+2 ;PROGRAM! * *MOVE TO NEW LOCATION * LDA #START STA $3C ;A1L LDA #<START STA $3D LDA #FINISH STA $3E ;A2L LDA #<FINISH STA $3F LDA #0 STA $42 ;A4L LDA DEST STA $43 LDY #0 JSR $FE2C ;MOVE * *PRINT A MESSAGE * JSR $FB39 ;SETTXT JSR $FC58 ;HOME LDA #MSG ;SYNTAX LDY #<MSG ;MESSAGE JSR $DB3A ;STROUT LDA #5 ;FIVE LINES STA $22 ;WNDTOP LDA #<SETUP ;DESTROYED CMP $B0 ;BASIC? BGE SU2 ;YES, TELL JSR $FE80 ;SETINV LDA #RELOAD ;USER TO LDY #<RELOAD ;RELOAD JSR $DB3A ;STROUT JSR $FE84 ;SETNORM LDA #8 ;MOVE STA $68 ;POINTERS LDA #0 ;BACK TAY ;TO STA $67 ;USUAL STA ($67),Y ;SPOT INC $67 ;$801 * *SET UP NEW & ADDRESS * SU2 LDA #$4C ;JMP STA $3F5 ;AMPER LDA #0 STA $3F6 ;AMPER LDA DEST STA $3F7 ;AMPER JSR CONJMP PLA ;FIX STA $AA59 ;BUG RTS * MSG ASC 'Applesoft Squeezer by Ray Groenestein' DFB $D ;NEW LINE ASC 'Copyright (C) 1992, MindCraft Publ.' DFB $D ;NEW LINE ASC 'Syntax: &P,first,inc,length' DFB $D ASC ' &C to Configure' DFB $D,$0 * RELOAD DFB $7 ;BELL ASC 'RELOAD YOUR BASIC PROGRAM' DFB $D,$0 * * ORG SETUP+$200 * *ENTRY FOR MAIN PROGRAM * START JSR $FF4A ;IOSAVE JSR $00B7 ;CHRGOT MODP BEQ STDFLT ;OR ISP AND #$5F ;ENSURE CAPITALS CMP #$43 ;C BNE ISP JSR $00B1 ;CHRGET CONJMP JMP CONFIG ISP CMP #$50 ;P MODCHN BNE OAALT ;OR ERR JSR $00B1 ;CHRGET STDFLT JSR PARSE ;GET MORE STY TLN ;FIRST STX TLN+1 ;LINE JSR PARSE ;NEXT ONE PHP ;SAVE STATUS STY INC TXA ;ARE STA INC+1 ;BOTH ORA INC ;ZERO? BNE NOT0 ;IF SO INC INC ;MAKE IT 1 NOT0 LDX #238 ;DEFAULT LENGTH PLP ;RETRIEVE STATUS BEQ DEFLEN ;Z-FLG SET=0 OR : JSR $E6F5 ;GETBYTC DEFLEN STX LEN ;LINE LENGTH BNE ERR LDY #1 ;HIGH BYTE STY FLAG ;FOR ONE LINE LDA ($67),Y ;ANY PROGRAM? BNE SVPTR ;TO PROCESS LDA #NOPROG ;NO LDY STABLE+2 ;TELL JMP $DB3A ;USER, GIVE UP PARSE JSR $00B7 ;CHRGOT BEQ PARSE1 ;0 OR : JSR $DEBE ;CHKCOM PARSE1 JSR $DA0C ;LINGET PHP ;SAVE STATUS LDY $50 ;ZERO IF LDX $51 ;NO NUMBER PLP ;RETRIEVE STATUS RTS ;AND LEAVE ERR JMP $DEC9 ;SNERR OAALT JSR $FF3F ;IOREST OLDAMP JMP $300 ;MODIFIED SVPTR LDA $B9 ;TXTPTR PHA ;SAVE LDA $B8 ;POINTERS PHA ;AND TSX ;THE STX SVSTACK ;STACK LDY #3 ;SET LDA #$FF ;UP SM1 STA ($AF),Y ;MARKERS DEY ;NEXT ONE BPL SM1 ;DONE? INY ;Y=0 STY $C1 ;FIX CHRGET * *FIRST PASS CHECK VARIABLES, SPACES, SEMI-COLONS, LINE NOS. * JSR SETPTRS ;SET UP FP1 LDX #3 ;COUNTER FP2 LDY #0 ;DEFAULT FOR FLAG JSR $00B1 ;CHRGET MODIFIED BEQ DOFLG ;CLEAR FLAG CHKTOK CMP #$BA ;PRINT BNE ISITREM ;LEAVE FLAG TAY ;FOR FLAG DOFLG STY PRTFLG ISITREM CMP #$B2 ;REM BEQ BNXLN ;SKIP REM CMP #$83 ;DATA BEQ TOEOS ;SKIP DATA TAY ;TOKEN? BPL FP5 ;- IS TOKEN LDX #6 ;6 TOKENS FP3 DEX ;NEXT ONE BMI FP1 ;ALL DONE? CMP TOKEN,X ;SAME? BNE FP3 ;NO, NEXT HEXSTR JSR PACKSTR ;STRING TO HEX LDA FLAG ;FOUND NUMBER? BEQ EXISTS ;NO, FORGET IT INX ;NEW NUMBER? BNE EXISTS ;NO, ITS THERE LDA LINNUM+1 ;YES, GET HEX VALUE STA (LPTR),Y ;INTO BUFFER DEY ;LOW LDA LINNUM ;BYTE STA (LPTR),Y ;TOO JSR ADLPTR ;SET LDA #$FF ;UP LDY #5 ;SOME FP4 STA (LPTR),Y ;MORE DEY ;MARKERS BPL FP4 ;DONE? EXISTS JSR CKCMIN ;ANOTHER STRING? BEQ HEXSTR ;YES, CHECK IT TAX ;ZERO? BMI CHKTOK ;TOKEN? BFP1 BNE FP1 ;MOVE ON BFP2 BNE FP2 ;LONG BRANCH TOEOS JSR $D995 ;DATA FP5 JSR $00B7 ;CHRGOT MOD BCS MODSC ;NUMBER? CPX #3 ;PART OF VAR? BCC CHKVAR ;YES CHECK IT MODSC CMP #$3B ;SEMI-COLON BNE ISPACE LDY PRTFLG ;IN PRINT? BEQ FP1 ;NO, NEXT LDY #1 ;FOR LDA ($B8),Y ;NEXT CHAR JSR $E07D ;ISLETC BCS CHKX ;LETTER? JSR $00BA ;NUMBER? BEQ FP1 ;LEAVE IF 0 OR : BCS FP7 ;ALPHANUMERIC? CHKX CPX #3 ;AFTER BEQ FP7 ;REAL VAR? BNE FP1 ;YES, GO BACK ISPACE CMP #$20 ;SPACE BEQ FP7 ;YES, REMOVE CMP #$22 ;QUOTE? BNE ISVAR ;NO, SKIP FP6 JSR $00B1 ;YES, NEXT CHAR TAY ;ZERO? BEQ NXLN ;YES, EOL CMP #$22 ;ANOTHER QUOTE? BNE FP6 ;NO, KEEP LOOKING ISVAR JSR $E07D ;ISLETC TAY ;ZERO? BNXLN BEQ NXLN ;YES, EOL BCC BFP1 ;LETTER? CHKVAR DEX ;DROP COUNT MODVAR BNE BFP2 ;>2 CHARS? DFB $24 ;BIT ZPAGE FP7 DEX ;FOR SPACE OR ; LDA #$AA LDY #0 ;FOR POINTER STA ($B8),Y ;TO BE REMOVED DFB $2C ;BIT ABS ALTVAR LDX #1 ;KEEP VARIABLE INX ;BUMP UP BNE BFP2 ;ALWAYS NXLN JSR CKEOP ;FINISHED BNE BFP1 ;NO, GO BACK * *RENUMBER THE LINES * JSR SETPTRS ;SET UP JSR $FC58 ;HOME SAMELIN INC FLAG ;=1 OR 2 SAMELN1 JSR SUBLOP ;SET BUFFER JSR ADDPTR ;AND P1 JSR ADLPTR ;POINTERS LDY #3 ;POINT TO LINE NO. LDA (LPTR),Y ;AND BUFFER CMP #$FF ;MARKER? BEQ NTFOUND ;YES, NOT THERE CMP (PPTR),Y ;SAME AS LINE NO? BNE P1 ;NO, NEXT DEY ;CHECK LDA (LPTR),Y ;LOW CMP (PPTR),Y ;BYTE BNE P1 ;TOO INC FLAG ;SET FLAG LDY #5 ;AND LDA TLN+1 ;STORE STA (LPTR),Y ;NEW DEY ;NUMBER LDA TLN ;IN STA (LPTR),Y ;BUFFER NTFOUND LDX #$AA ;LET=REMOVE LDY #1 ;FIRST LDBYTE LDA ($B8),Y ;BYTE BNE CKCOLON ;NO EMPTY LINES DEY ;REPLACE LDA #$B2 ;SINGLE COLON STA ($B8),Y ;WITH REM CKCOLON CMP #$3A ;COLON? BNE CKFLG TXA ;REPLACE STA ($B8),Y ;WITH INY ;LET BNE LDBYTE ;ALWAYS CKFLG LDA FLAG ;NEED NEW LINE? BNE PRINTNO ;YES, PRINT IT LDA #$3A ;INV : JSR $FDED ;PRINT IT LDA #$FF ;MARKER INC COMFLG ;FOR BPL STPP ;COMBINATION PRINTNO JSR PRTLIN ;ALSO FIX FLAGS STPP LDY #3 ;OFFSET STA (PPTR),Y ;STORE HIGH DEY ;AND TXA ;LOW BYTE STA (PPTR),Y ;IN PROGRAM NXCH JSR UNPACK ;ANALYSE BYTE BEQ ENDLN ;0=NEW LINE BPL NOTTOK ;TOKEN? JSR MODREM ;REM? BEQ ENDLN ;SKIP THE REST CMP #$AA ;LET? BEQ NXCH ;SKIP THAT TOO CMP #$B4 ;ON BNE MODNLD CKON1 JSR MODPRT ;PRINT THE VERB CKON2 JSR UNPACK ;NEXT BYTE BEQ ENDLN ;0=EOL BMI CKON1 ;TOKEN? LDY QFLG ;IN QUOTE? BNE CKON3 ;YES, SKIP CMP #$3A ;COLON : BEQ NOTTOK ;END OF ON CKON3 JSR LST ;PRINT IT BNE CKON2 ;ALWAYS NOTTOK JSR LST ;PRINT IT BNE NXCH ;ALWAYS MODNLD LDX #12 ;12 OR 13 TOKENS NXX DEX ;NEXT TOKEN BMI NOTFLG ;NOT FOUND? CMP TOKEN2,X ;MATCHES? BNE NXX ;NO, NEXT INC FLAG ;FOUND ONE NOTFLG JSR MODPRT ;PRINT AND COUNT BNE NXCH ;ALWAYS ENDLN LDX LEN ;CHECK LENGTH CPX COUNT ;MORE THAN COUNT? BCS CNTOK ;NO, ITS OK SLJMP LDA COMFLG ;ONE LINE ONLY BNE SL1 ;NO, A COMBINATION JSR CKEOP ;LAST LINE BEQ CTP ;YES, LEAVE SL1 JMP SAMELIN ;KEEP THE LINE CNTOK JSR CKEOP ;LAST ONE? BEQ CTP ;MAYBE INC COUNT ;BUMP, NEVER ZERO JMP SAMELN1 ;COMBINE? * *COMPRESS OR UNPACK THE PROGRAM * CTP LDY #$FF ;FIND STY LINNUM ;END JSR CKBUF ;OF LDY LPTR+1 ;BUFFER INY ;NEXT STY HSTORE ;PAGE STY NPRG+1 ;FOR LDA $67 ;NEW STA NPRG ;PROGRAM JSR SETPTRS ;SET UP LDY #3 ;RETRIEVE LDA (PPTR),Y ;NUMBER STA (NPRG),Y ;AND STA TLN+1 ;MOVE DEY ;TO LDA (PPTR),Y ;THE STA (NPRG),Y ;BUFFER STA TLN JSR COMP ;COMPRESS OR UNPACK RSTPTR PLA ;RESTORE STA $B8 ;THE PLA ;STACKED STA $B9 ;POINTERS LDA #$EF ;RESTORE STA $C1 ;CHRGET JMP $D66C ;CLEAR MEMORY AND LEAVE * *COPY BYTES TO BUFFER * NOTEOP LDY NPRG+1 ;HIT JSR CKMEM ;HIMEM:? LDY #3 ;POINT TO LINE NO. LDA (PPTR),Y ;HIGH BYTE TAX ;SAVE IT LDY YSTORE ;JUST IN CASE LDA #$3A ;DEFAULT STA (NPRG),Y ;IN PROGRAM INX ;WAS X=FF? BEQ CN2 ;YES, LEAVE CN0 LDA #0 ;CLEAR STA DATAFLG ;FLAG CN1 JSR ADDINC ;NEXT NUMBER JSR FEL ;FIX END OF LINE BCS CN3 ;TOO LONG? INY LDA TLN ;STORE STA (NPRG),Y ;THE INY ;LINE LDA TLN+1 ;NUMBERS STA (NPRG),Y LDA DATAFLG ;SET MEANS BEQ COMP ;IN DATA LDY #4 ;FIRST TOKEN STA (NPRG),Y ;IS DATA DFB $2C ;BIT ABS, SKIP 2 BYTES COMP LDY #3 ;ENTRY POINT CN2 INY ;BUMP BNE LDPP ;OK, MOVE ON CN3 JSR TOOLONG BNE LINEND2 ;END THIS LINE NEBR BNE NOTEOP ;LONG HOP LDPP JSR $00B1 ;NEXT BYTE STNP JSR ISQT ;QUOTE OR ZERO? BEQ LINEND ;YES, EOL STA (NPRG),Y ;NO, STORE BPL CN2 ;TOKEN? ISMARK CMP #$F8 ;MARKER? BEQ CN1 ;YES, NEW LINE CMP #$F9 ;END OF DATA? BEQ CN0 ;YES, NEW LINE JSR MODREM ;REM? BEQ LECKY ;REMOVE IT CMP #$AA ;LET BEQ LDPP ;SUPERFLUOUS CMP #$83 ;DATA BNE CLRDF ;NO,CLEAR FLAG LDX DATAFLG ;FLAG SET MODPD BEQ SETDF ;NO, SET IT DEY ;YES, REPLACE LDA #$2C ;COLON WITH COMMA BNE STNP ;ALWAYS CLRDF LDX #0 ;CLEAR FALLS THROUGH DFB $24 ;BIT ZP SETDF TAX ;TOKEN TO XREG STX DATAFLG ;$83 OR 0 LDX #6 ;6 TOKENS CT3 DEX ;NEXT BMI CN2 ;NOT FOUND? CMP TOKEN,X ;SAME? BNE CT3 ;NO, NEXT STRFND INY ;FOUND ONE BEQ CN3 ;TOO LONG STY YSTORE ;SAVE IT JSR PACKSTR ;STRING TO HEX LDA FLAG ;FOUND STRING? BEQ NONUM ;NO, FORGET IT JSR YESNUM ;REPLACE WITH NEW STRING NONUM JSR CKCMIN ;ANOTHER STRING? STA (NPRG),Y ;STORE ,-0: OR TOKEN BEQ STRFND ;FOUND ANOTHER TAX ;NO, ZERO? BMI ISMARK ;TOKEN? BNE CN2 ;MOVE ON? BPL LINEND ;ZERO FOUND LECKY CPY #4 ;CHECK Y BEQ LINEND ;NEW LINE DEY ;ITS OK LINEND LDA QFLG ;QUOTE CLOSED? BEQ LINEND2 ;NO, CLOSE IT STA (NPRG),Y ;A=$22 INY BEQ CN3 ;TOO LONG LINEND2 STY YSTORE ;NO, SAVE Y JSR CKEOP ;LAST LINE? BNE NEBR ;LONG HOP BACK LDY YSTORE ;RETRIEVE YREG JSR FEL ;END OF LINE BCS CN3 ;TOO LONG? LDA NPRG ;MOVE STA $42 ;ZEROS LDA NPRG+1 ;AND STA $43 ;MACHINE LDA $B8 ;LANGUAGE STA $3C ;IF LDA $B9 ;ANY STA $3D ;TO SEC LDA $AF ;NEW STA $3E ;PROGRAM SBC $B8 TAX LDA $B0 STA $3F SBC $B9 TAY CLC TXA ADC NPRG TAX TYA ADC NPRG+1 CMP $74 BCC ISOK JMP OOMEM ISOK PHA LDY #0 JSR $FE2C ;MOVE TXA ;NOW STA $3E ;MOVE PLA ;IT STA $3F ;ALL LDA HSTORE ;BACK STA $3D ;AGAIN LDA $67 STA $3C STA $42 LDA $68 STA $43 JSR $FE2C ;MOVE JSR $FD8E ;CROUT DEC $42 ;ADJUST BNE NODEC ;THE DEC $43 ;POINTER NODEC SEC ;READY TO SUBTRACT LDA $42 ;SET STA $AF ;OF PROGRAM STA $69 ;AND LOMEM SBC $67 ;- LO BYTE OF START TAX ;FOR LINPRT LDA $43 ;HIGH STA $B0 ;BYTE STA $6A ;TOO SBC $68 JSR $ED24 ;LINPRT LDA #BYTES ;LO BYTE LDY STABLE+2 ;HI BYTE JMP $DB3A ;STROUT * *SUBROUTINES * *CHECK FOR END OF PROGRAM * CKEOP LDY #0 ;GET LDA (PPTR),Y ;POINTERS TAX ;AND INY ;SAVE LDA (PPTR),Y ;THEM STX PPTR ;IN STA PPTR+1 ;BOTH STX $B8 ;POINTERS STA $B9 LDA (PPTR),Y ;ZERO? BEQ EXEOP ;0=END OF PROGRAM STA $B9 ;IS DEY ;IT LDA (PPTR),Y ;THE STA $B8 ;LAST INY ;LINE? LDA ($B8),Y ;ZERO? BNE ADDPTR ;0=LAST LINE ADDPTR CLC ;NOW LDA PPTR ;MOVE ADC #3 ;UP STA $B8 ;FIRST LDA #0 ;BYTE STA REMFLG ;CLEAR STA COMFLG ;SOME STA QFLG ;FLAGS ADC PPTR+1 ;HIGH STA $B9 ;BYTE EXEOP RTS ;RETURN * *SET POINTERS TO START OF PROGRAM * SETPTRS LDA $67 ;TXTTAB STA PPTR ;THREE LDA $68 ;POINTERS STA PPTR+1 ;TO SET STA LSTORE ;FOR NEW PROGRAM BNE ADDPTR ;ALWAYS * *INIT POINTER TO BUFFER * SUBLOP SEC ;READY LDA $AF ;VARTAB SBC #6 ;ALIGN STA LPTR ;BUFFER LDA $B0 ;AND SBC #0 ;PROGRAM STA LPTR+1 ;POINTERS RTS * *CONVERT STRING TO HEX AT $50,$51 * PACKSTR LDA #0 ;CLEAR STA FLAG ;FLAG PS1 JSR $00B1 ;GET BYTE BCC PS2 ;NUMBER? CMP #$AA ;LET BEQ PS1 ;YES, KEEP LOOKING EXPS RTS ;NO, LEAVE PS2 INC FLAG ;FOUND NO. JSR $DA0C ;LINGET CKBUF JSR SUBLOP ;START OF CB1 JSR ADLPTR ;BUFFER LDY #3 ;ORIGINAL LDA (LPTR),Y ;NUMBER TAX ;SAVE CMP #$FF ;MARKER? BEQ EXPS ;NOT FOUND CMP LINNUM+1 ;SAME? BNE CB1 ;NO, NEXT DEY ;CHECK LDA (LPTR),Y ;LOW CMP LINNUM ;BYTE BNE CB1 ;TOO RTS ;FOUND IT * *FIND TOKEN, PRINT AND COUNT * MODPRT CMP #$BA ;PRINT BEQ LDQM ;USE ? SEC ;READY SBC #$7F ;GET INDEX TAX ;IN X REG LDY #$D0 ;OFFSET STY $9D ;TOKENPTR DEY STY $9E ;TOKENPTR LDY #$FF ;INITIALISE Y REG TOK1 DEX ;NEXT TOKEN BEQ TOK2 ;FOUND TOK TOK JSR $D72C ;NXTOK BPL TOK ;MORE IN THIS ONE? BMI TOK1 ;LAST CHAR IS MINUS TOK2 JSR $D72C ;FOR OUR TOKEN BMI LST ;END OF TOKEN? ORA #$80 ;SCREEN FORMAT MODLST LDX #8 ;OR INC COUNT ($8) BEQ EXLST ;TOO BIG? JSR $DB64 ;PRTWT BNE TOK2 ;ALWAYS LDQM LDA #$3F ;? LST INC COUNT ;LAST CHAR BEQ EXLST ;TOO LONG? CMP #$1F ;CONTROL? BCS NTCTRL ;MASK ORA #$40 ;FLASH OR INV DFB $2C ;BIT ABS NTCTRL ORA #$80 ;NORMAL JMP $DB64 ;PRTWT Z=0 EXLST PLA ;FIX PLA STACK JMP SLJMP ;TOO LONG * *CONVERT HEX TO STRING AT $100 * YESNUM LDY #5 ;POINT LDA (LPTR),Y ;TO NEW NUMBER CMP #$FF ;MARKER? BNE REFOK ;NO, ALL IS WELL LDA #$F2 ;UNDEF STMENT JSR DOERR ;PRINT ERROR MSG LDY LINNUM ;CHANGE LDA LINNUM+1 ;OLD HEX JMP PROCESS ;TO STRING REFOK TAX ;SAVE DEY LDA (LPTR),Y ;LOW BYTE TAY ;TO Y REG TXA ;HIGH IN A REG PROCESS JSR $E2F2 ;GIVAYF JSR $ED34 ;FOUT LDY YSTORE ;CURRENT POSITION LDX #0 ;FOR FIRST ONE PR2 LDA $100,X ;GET BYTE BEQ EXYN ;0=FINISHED STA (NPRG),Y ;STORE INY ;BUMP BNE PR3 ;USUALLY PLA ;FIX PLA ;STACK JMP CN3 ;TOO LONG PR3 INX ;BUMP BNE PR2 ;ALWAYS EXYN STY YSTORE ;SAVE IT RTS ;AND LEAVE * *OUTPUT THE LINE * LINDO JSR $FD8E ;CROUT LDX TLN ;PRINT LDA TLN+1 ;THE JSR $ED24 ;NUMBER LDX $24 ;SAVE STX COUNT ;ITS RTS ;LENGTH * *PRINT LINE NO. AND SAVE LENGTH * PRTLIN JSR LINDO MODUPL LDA #0 ;1=DONT UNPACK STA IFFLG MODPL LDA #0 ;1 = NEW LINE STA FLAG LDX TLN ;RETRIEVE LDA TLN+1 ;NUMBER ADDINC PHA ;SAVE A REG AI1 CLC ;CALCULATE LDA TLN ;NEXT ADC INC ;LINE STA TLN ;NUMBER LDA TLN+1 ;AND ADC INC+1 ;HIGH STA TLN+1 ;BYTE BCS AI2 ;TOO CMP #$FA ;BIG? BLT EXAI AI2 LDA #$EF ;ILLEGAL QUANTITY JSR DOERR ;PRINT MSG JMP OM1 ;AND QUIT EXAI PLA ;A-REG RTS ;RETURN * *FIX END OF LINE * FEL LDA #$3A ;COLON STA (NPRG),Y ;FOR DEFAULT TYA ;NEAR CLC ;255? ADC #7 BCS FEL3 ;CLEAR=OK CPY #4 ;EMPTY BNE FEL2 ;LINE? INY FEL2 LDA #0 STA (NPRG),Y ;0=EOL INY STY YSTORE ;SAVE YREG * *PUT POINTER AT THE START OF A LINE * LDY #0 ;FIRST BYTE CLC ;READY TO ADD LDA NPRG ;POSITION ADC YSTORE ;TO STA (NPRG),Y ;OFFSET PHP ;SAVE STATUS TAX ;AND LOCATION LDA LSTORE ;ACTUAL ADDRESS ADC #0 ;IN STA LSTORE ;LOW MEMORY INY ;HIGH STA (NPRG),Y ;BYTE PLP ;RESTORE STATUS BCC SKIP ;WAS CARRY CLEAR? INC NPRG+1 ;NO, BUMP SKIP STX NPRG ;NEW ADDRESS LDX NPRG+1 ;MEMORY INX ;STILL CPX $74 ;OK? BGE OOMEM * *CHECK FOR REM * MODREM CMP #$B2 ;REM (MOD LDX #1) CLC FEL3 RTS * *MOVE TO NEXT NUMBER IN BUFFER * ADLPTR CLC ;MOVE LDA LPTR ;UP ADC #4 ;TO STA LPTR ;NEXT BCC EXIT ;LINE INC LPTR+1 ;NUMBER LDY LPTR+1 ;AND CKMEM INY ;CHECK CPY $74 ;HIMEM BGE OOMEM EXIT RTS * *HANDLE OUT OF MEMORY * OOMEM JSR $FD8E ;CROUT LDA #$F1 ;OUT OF MEMORY JSR DE1 OM1 LDX SVSTACK ;CLEAR TXS ;STACK JMP RSTPTR ;AND LEAVE * *CHECK COMMA AND DASH (MINUS) * CKCMIN JSR $00B7 ;RETRIEVE BYTE LDY YSTORE ;READY TO STORE BYTE CMP #$2C ;COMMA BEQ EXCK ;ANOTHER STRING FOLLOWS CMP #$C9 ;DASH EXCK RTS ;ZFLAG IS CORRECT * *PRINT LENGTH ERROR MESSAGE * TOOLONG LDA #$F8 ;LINE TOO LONG DOERR PHA ;STORE CODE JSR LINDO ;PRINT LINE NO LDA #$A0 ;SPACE JSR $FDED ;COUT PLA ;ERROR TOKEN DE1 JSR MODPRT ;PRINT IT JSR $FF3A ;BELL LDY #5 ;CORRECT LENGTH RTS ;AND RETURN * *CHECK FOR A NEW LINE * UNPACK JSR $00B1 PHA ;SAVE LDX #$F8 ;LINE TOO LONG LDY REMFLG ;IN REM? BNE BEXUP ;SKIP THE REST. LDY QFLG ;IN QUOTE? BNE AREM ;YES, SKIP LDY DATAFLG ;IN DATA? BEQ COLON1 ;SKIP COMMA MODUPD CMP #$2C ;COMMA? BEQ LDIFLG COLON1 CMP #$3A ;COLON : BNE AREM ;NO, CHECK IT LDY #1 LDA ($B8),Y ;NEXT BYTE BNE ISCOLON ;0=COLON AT EOL REMOVE LDY #0 ;SPURIOUS BYTE LDA #$AA ;LET=REMOVE STA ($B8),Y ;FIRST ONE PLA ;FIX STACK BNE UNPACK ;ANY MORE? ISCOLON CMP #$3A ;ANOTHER COLON? BEQ REMOVE ;YES, REMOVE LDY DATAFLG ;END OF DATA? BEQ LDIFLG ;NO, USE $F8 INX ;USE $F9 LDIFLG LDY IFFLG ;IF? BEXUP BNE EXUP ;YES, DONT UNPACK LDY COUNT CPY LEN ;BIGGER? BCC EXUP ;NO, LEAVE LDY #0 ;YES STY COUNT ;RESET COUNT TXA ;$F8 OR $F9 STA ($B8),Y ;REPLACE COLON OR COMMA JMP AI1 ;NEW NUMBER AREM CMP #$B2 ;REM? BNE ISITDAT STA REMFLG ISITDAT CMP #$83 ;DATA BEQ ISDATA CMP #$AD ;IF? BNE ISTHEN INC IFFLG ;SET FLAG ISTHEN CMP #$C4 ;THEN BNE CHKPL ;CHECK LDY #0 ;FOR IT1 INY ;SUPERFLUOUS LDA ($B8),Y ;TOKENS CMP #$AA ;LET? BEQ IT1 ;YES, IGNORE CMP #$AB ;GOTO BEQ REMOVE ;IS SUPERFLUOUS CHKPL PLA ;RETRIEVE BPL ISQT CMP #$AA ;LET BEQ ISQT ;YES; IGNORE LDY #0 ;CLEAR FLAG STY DATAFLG ISQT PHA ;ENTRY FOR COMPACT CMP #$22 ;QUOTE BNE EXUP EOR QFLG ;TOGGLE STA QFLG ;FLAG EXUP PLA ;RETRIEVE A REG RTS ;LEAVE * *DEAL WITH DATA STATEMENTS * ISDATA STA DATAFLG ;A=$83 LDY #0 ;INITIALISE Y-REG FRONT LDX #$AA ;LET=REMOVE DT1 INY ;REMOVE LDA ($B8),Y ;LEADING CMP #$20 ;SPACE BNE REST ;MORE SPACES? TXA ;REPACE STA ($B8),Y ;WITH BNE DT1 ;LET TOCOM CMP #$2C ;COMMA BEQ FRONT ;MORE DATA? CMP #$3A ;COLON BEQ EOSTMT ;NO, LEAVE TAX ;ZERO BEQ EXUP ;MEANS EOL INY ;SKIP LDA ($B8),Y ;GOOD BPL TOCOM ,DATA REST CMP #$22 ;QUOTE BNE TOCOM ;SKIP REST R1 INY ;SKIP LDA ($B8),Y ;TO BEQ EXUP ;NEXT CMP #$22 ;QUOTE BNE R1 R2 INY ;REMOVE LDA ($B8),Y ;TRAILING CMP #$20 ;SPACES BNE TOCOM ;AFTER LDA #$AA ;A STA ($B8),Y ;QUOTE BNE R2 ;ALWAYS EOSTMT INY ;ANOTHER LDA ($B8),Y ;DATA CMP #$83 ;RELACE BNE EXUP ;WITH LDA #$2C ;COMMA STA ($B8),Y ;AND THE DEY ;COLON WITH LDA #$AA ;LET STA ($B8),Y ;MOVE INY ;FORWARD BNE FRONT ;ALWAYS * *SELECT OPTIONS * CONFIG JSR $FC58 ;HOME LDA #8 ;VTAB9 JSR $FB5B ;TABV LDY #11 ;12 ROWS DOT LDX #30 ;31 DOTS LDA #$AE ;DOT DOT1 JSR $FDED ;COUT DEX ;NEXT DOT BPL DOT1 ;MORE? JSR $DAFB ;CRDO DEY ;NEXT LINE BPL DOT ;MORE? LDA #6 ;VTAB7:HTAB7 STA $24 ;CH JSR $FB5B ;TABV * *PRINT TEXT * LDX #$FF ;SET INDEX PT1 LDA #$A0 ;SPACE STA CSTORE ;FOR RDKEY PT2 INX ;NEXT CHAR JSR $FDED ;COUT LDA HEADING,X ;GET CHAR BEQ TOGGLE ;0=FINISHED CMP #$8D ;RETURN? BNE PT2 ;NO, NEXT JSR $DAFB ;CRDO BCS PT1 ;ALWAYS * *PRINT STATUS * TOGGLE LDA #8 ;VTAB9 JSR $FB5B ;TABV LDA #0 ;ZERO STA COUNT ;COUNTER ENTRY JSR XOFFST ;MULTIPLY STA STABLE+1 LDA #30 ;HTAB31 STA $24 ;CH STABLE LDA VALTBL ;SAME CMP (LOC),Y ;AS BEQ ORIG ;PROGRAM INY ;NO, Y=>1 LDX #OFF DFB $2C ,BIT ABS ORIG LDX #ON TYA ;Y=0 OR 1 LDY COUNT ;POINT TO ARRAY STA STATE,Y ;STORE STATUS TXA ;ON OR OFF LDY STABLE+2 ;HI BYTE JSR $DB3A ;STROUT INC COUNT LDA COUNT ;FINISHED CMP #12 ;YET? BNE ENTRY ;NO, GO BACK * *GET INPUT * LDA #17 ;HTAB18 STA $24 ;CH LDA #21 ;VTAB 22 JSR $FB5B ;TABV E5 LDA CSTORE ;RETRIEVE CHAR JSR $FDED ;COUT LDA #$88 ;BACK SPACE JSR $FDED ;COUT JSR $FD0C ;RDKEY CMP #$9B ;ESC? BEQ EXCON ;YES, LEAVE CMP #$A0 ;CONTROL BCS SVCHR ;CHARACTER? LDA #$A0 ;USE SPACE SVCHR STA CSTORE ;SAVE IT AND #$5F ;UPPER CASE CMP #$41 ;A BCC E6 CMP #$4D ;M BCC ONEFND E6 JSR $FF3A ;BELL BPL E5 ;ALWAYS ONEFND SEC SBC #$41 ;OFFSET TAX ;TO LDA STATE,X ;STATUS PHA ;SAVE IT TXA ;X=OFFSET STA COUNT JSR XOFFST ;MULTIPLY STA GETALT+1 ;AND STORE PLA ;RETRIEVE STATUS EOR #1 ;TOGGLE 0<->1 TAX ;STORE GETALT LDA VALTBL,X ;OTHER STA (LOC),Y ;VALUE JMP TOGGLE ;DO IT AGAIN XOFFST ASL A ;*2, CLEARS C PHA ;SAVE ADC COUNT ;TRIPLE TAX ;OFFSET LDA POSTBL+1,X STA LOC ;LO BYTE INX LDA POSTBL+1,X STA LOC+1 ;HI BYTE PLA ;=DOUBLE ADC #VALTBL ;C IS CLEAR LDY #0 EXCON RTS * *RELOCATABLE TABLES * POSTBL JMP MODP+1 ;A JMP MODCHN+1 ;B JMP MODREM ;C JMP MODSC ;D JMP MODVAR+1 ;E JMP MODPRT ;F JMP MODLST ;G JMP MODPD ;H JMP MODUPD ;I JMP MODNLD+1 ;J JMP MODPL+1 ;K JMP MODUPL+1 ;L * HEADING ASC 'CONFIGURE SQUEEZER' DFB $8D,$8D * OPTIONS ASC 'A. Invoke with &' DFB $8D ASC 'B. Chain' DFB $8D ASC 'C. Remove REMs' DFB $8D ASC 'D. Remove semi-colons' DFB $8D ASC 'E. Shorten variables' DFB $8D ASC 'F. Use ? for PRINT' DFB $8D ASC 'G. Use 1 char tokens' DFB $8D ASC 'H. Pack DATA' DFB $8D ASC 'I. Unpack DATA' DFB $8D ASC 'J. Use new lines for DATA' DFB $8D ASC 'K. Pack lines' DFB $8D ASC 'L. Unpack lines' DFB $8D,$8D PROMPT ASC 'Type A-L or Esc: ' DFB $0 * VALTBL DFB $13,$0C ;A,BRANCH DFB $4A,$47 ;B,BRANCH DFB $C9,$A2 ;C,CMP IMM,LDX IMM DFB $C9,$A0 ;D,CMP IMM,LDY IMM DFB $B7,$09 ;E,BRANCH DFB $C9,$A2 ;F,CMP IMM,LDX IMM DFB $A2,$E6 ;G,LDX IMM,INC ZPG DFB $F0,$B0 ;H,BEQ,BCS DFB $C9,$A0 ;I,CMP IMM,LDY IMM DFB $D,$C ;J,NO OF TOKENS DFB $0,$1 ;K,FLAG DFB $0,$1 ;L,FLAG * ON ASC 'ON ' DFB $8D,$0 OFF ASC 'OFF' DFB $8D,$0 * BYTES ASC ' BYTES' DFB $0 ;END OF MSG * NOPROG ASC 'NO PROGRAM' DFB $87,$0 ;BELL, END * STATE DFB $0,$0,$0,$0,$0,$0 DFB $0,$0,$0,$0,$0,$0 * *6 TOKENS WITH POSSIBLE LINE NO. * TOKEN DFB $BC,$C4,$B0 ;LIST,THEN,GOSUB * *12 TOKENS WHICH TERMINATE A LINE * TOKEN2 DFB $85,$AB,$AC ;DEL,GOTO,RUN DFB $BF,$B6,$B3 ;NEW,LOAD,STOP DFB $A6,$80,$A5 ;RESUME,END,ONERR DFB $B2,$B1,$AD ;REM,RETURN,IF DFB $83 ;DATA, OPTIONAL FINISH EQU *